Professor : João Batista M. Pereira
Aluno : Marcel Quintela
O conjunto de dados a ser analisado corresponde a registros públicos de vendas de casas feitas de maio de 2014 a maio de 2015 no Condado de King, no estado de Washington, EUA.
O banco de dados está dividido em dois arquivos: kchousing1.csv e kchousing2.csv. No primeiro arquivo, as variáveis são:
No segundo arquivo as variaveis são:
id - identificação única da casa vendida;
date - data da venda;
grade - um índice de 1 a 13, em que:
sqft above - pés quadrados do interior da casa acima do nível do solo;
sqft basement - pés quadrados do interior da casa abaixo do nível do solo;
yr_built - ano em que a casa começou a ser construída;
yr_renovated - ano da última reforma da casa;
zipcode - código postal da casa;
lat - latitude;
long - longitude;
sqft living15 - pés quadrados do interior das 15 casas mais próximas;
sqft lot15 - pés quadrados do terreno das 15 casas mais próximas.
Orientações para cosntrução da Atividade1
Importe as bases de dados nos arquivos para o R e junte-as em um único data frame com todos os registros e todas as variáveis. Lembre-se que as linhas correspondem aos registros de vendas e uma casa pode ser vendida mais de uma vez.
Escolha pelo menos três variáveis do banco de dados e faça uma análise exploratória. Utilize gráficos tais como histogramas, box-plots, gráfico de barras e/ou gráfico de setores. Para as variáveis quantitativas, pode-se também calcular algumas medidas resumo tais como média, mediana, desvio padrão.
house1<-read.csv("kc_housing_1.csv",sep=",")
head(house1)
## id date price bedrooms bathrooms sqft_living sqft_lot
## 1 7129300520 20141013T000000 221900 3 1.00 1180 5650
## 2 6414100192 20141209T000000 538000 3 2.25 2570 7242
## 3 5631500400 20150225T000000 180000 2 1.00 770 10000
## 4 2487200875 20141209T000000 604000 4 3.00 1960 5000
## 5 1954400510 20150218T000000 510000 3 2.00 1680 8080
## 6 7237550310 20140512T000000 1225000 4 4.50 5420 101930
## floors waterfront view condition date2
## 1 1 0 0 3 2014-10
## 2 2 0 0 3 2014-12
## 3 1 0 0 3 2015-02
## 4 1 0 0 5 2014-12
## 5 1 0 0 3 2015-02
## 6 1 0 0 3 2014-05
house2<-read.csv("kc_housing_2.csv",sep=",")
head(house2)
## id date grade sqft_above sqft_basement yr_built
## 1 7129300520 20141013T000000 7 1180 0 1955
## 2 6414100192 20141209T000000 7 2170 400 1951
## 3 5631500400 20150225T000000 6 770 0 1933
## 4 2487200875 20141209T000000 7 1050 910 1965
## 5 1954400510 20150218T000000 8 1680 0 1987
## 6 7237550310 20140512T000000 11 3890 1530 2001
## yr_renovated zipcode lat long sqft_living15 sqft_lot15
## 1 0 98178 47.5112 -122.257 1340 5650
## 2 1991 98125 47.7210 -122.319 1690 7639
## 3 0 98028 47.7379 -122.233 2720 8062
## 4 0 98136 47.5208 -122.393 1360 5000
## 5 0 98074 47.6168 -122.045 1800 7503
## 6 0 98053 47.6561 -122.005 4760 101930
Mesclando os dataframes importados em único dataframe usando como chave o “ID da venda” e a “data da venda”, criando assim o banco de dados das operações de venda e caracteristicas das casas.
vendas<-merge(house1,house2,by=c("id","date"))
#checando os tamanhos dos data frames
dim(house1)
## [1] 21613 12
dim(house2)
## [1] 21613 12
dim(vendas)
## [1] 21613 22
names(house1)
## [1] "id" "date" "price" "bedrooms" "bathrooms"
## [6] "sqft_living" "sqft_lot" "floors" "waterfront" "view"
## [11] "condition" "date2"
names(house2)
## [1] "id" "date" "grade" "sqft_above"
## [5] "sqft_basement" "yr_built" "yr_renovated" "zipcode"
## [9] "lat" "long" "sqft_living15" "sqft_lot15"
names(vendas)
## [1] "id" "date" "price" "bedrooms"
## [5] "bathrooms" "sqft_living" "sqft_lot" "floors"
## [9] "waterfront" "view" "condition" "date2"
## [13] "grade" "sqft_above" "sqft_basement" "yr_built"
## [17] "yr_renovated" "zipcode" "lat" "long"
## [21] "sqft_living15" "sqft_lot15"
head(vendas)
## id date price bedrooms bathrooms sqft_living sqft_lot
## 1 1000102 20140916T000000 280000 6 3.0 2400 9373
## 2 1000102 20150422T000000 300000 6 3.0 2400 9373
## 3 100100050 20141112T000000 275000 3 1.0 1320 11090
## 4 1001200035 20150306T000000 272450 3 1.0 1350 7973
## 5 1001200050 20140923T000000 259000 4 1.5 1260 7248
## 6 1003000175 20141222T000000 221000 3 1.0 980 7606
## floors waterfront view condition date2 grade sqft_above sqft_basement
## 1 2.0 0 0 3 2014-09 7 2400 0
## 2 2.0 0 0 3 2015-04 7 2400 0
## 3 1.0 0 0 3 2014-11 7 1320 0
## 4 1.5 0 0 3 2015-03 7 1350 0
## 5 1.5 0 0 5 2014-09 7 1260 0
## 6 1.0 0 0 3 2014-12 7 980 0
## yr_built yr_renovated zipcode lat long sqft_living15 sqft_lot15
## 1 1991 0 98002 47.3262 -122.214 2060 7316
## 2 1991 0 98002 47.3262 -122.214 2060 7316
## 3 1955 0 98155 47.7748 -122.304 1320 8319
## 4 1954 0 98188 47.4323 -122.292 1310 7491
## 5 1955 0 98188 47.4330 -122.292 1300 7732
## 6 1954 0 98188 47.4356 -122.290 980 8125
rm(house1,house2) #Liberando memória: removendo os dados originais
#Extração das variaveis de estudo
house.1<-vendas[,c(3,4,5,6,10,13)]
#Ajute das variáveis de preço
house.1$price<-house.1$price/1000
nomes<-c("Preço da Casa (x US$1.000)","Nº de Quartos", "Nº de Banheiros","Interior da Casa (ft²)","Visão da Propriedade","Nível de Construção e Design")
#Resumos
EstDescri=function(x) { #função que retorna as resumo descritivo das variáveis
c(NumObs = length(x),
Maximo = max(x, na.rm=T),
Minimo = min(x, na.rm=T),
Amplitude = max(x, na.rm=T)-min(x, na.rm=T),
Media = mean(x, na.rm=T),
#Mediana = median(x, na.rm=T),
Q = quantile(x,na.rm=T)[2],
Q = quantile(x,na.rm=T)[3],
Q = quantile(x,na.rm=T)[4],
Variancia = var(x, na.rm=T),
DesPadrao = sd(x, na.rm=T),
CV = 100* sd(x, na.rm=T)/mean(x, na.rm=T),
Iqr = IQR(x, na.rm=T), # Desvio Interquartilico
Ass = 3*(mean(x, na.rm=T)- median(x, na.rm=T))/sd(x, na.rm=T),
Cur = IQR(x, na.rm=T)/(2*(quantile(x,.90,na.rm=T)-quantile(x,.10,na.rm=T)))
)
}
Resultados<- data.frame(EstDescri(house.1[,1]))
names(Resultados)[1]<-names(house.1)[1]
for (x in 2:length(house.1)){
Resultados<-cbind(Resultados, EstDescri(house.1[,x]))
names(Resultados)[x]<-names(house.1)[x]
}
names(Resultados)<-nomes
knitr::kable(Resultados,digits = 2,format.args = list(scientific = FALSE),
caption = "Resumo descritivo das variáveis de estudo")
| Preço da Casa (x US$1.000) | Nº de Quartos | Nº de Banheiros | Interior da Casa (ft²) | Visão da Propriedade | Nível de Construção e Design | |
|---|---|---|---|---|---|---|
| NumObs | 21613.00 | 21613.00 | 21613.00 | 21613.00 | 21613.00 | 21613.00 |
| Maximo | 7700.00 | 33.00 | 8.00 | 13540.00 | 4.00 | 13.00 |
| Minimo | 75.00 | 0.00 | 0.00 | 290.00 | 0.00 | 1.00 |
| Amplitude | 7625.00 | 33.00 | 8.00 | 13250.00 | 4.00 | 12.00 |
| Media | 540.09 | 3.37 | 2.11 | 2079.90 | 0.23 | 7.66 |
| Q.25% | 321.95 | 3.00 | 1.75 | 1427.00 | 0.00 | 7.00 |
| Q.50% | 450.00 | 3.00 | 2.25 | 1910.00 | 0.00 | 7.00 |
| Q.75% | 645.00 | 4.00 | 2.50 | 2550.00 | 0.00 | 8.00 |
| Variancia | 134782.38 | 0.87 | 0.59 | 843533.68 | 0.59 | 1.38 |
| DesPadrao | 367.13 | 0.93 | 0.77 | 918.44 | 0.77 | 1.18 |
| CV | 67.98 | 27.59 | 36.42 | 44.16 | 327.06 | 15.35 |
| Iqr | 323.05 | 1.00 | 0.75 | 1123.00 | 0.00 | 1.00 |
| Ass | 0.74 | 1.20 | -0.53 | 0.55 | 0.92 | 1.68 |
| Cur.90% | 0.25 | 0.25 | 0.19 | 0.26 | NaN | 0.17 |
Numa análise preliminar, pode-se afirmar a grande amplitude nos Preços de Vendas das casa e no Interior da Casa (ft²). O custo médio das casas no recorte foi de US$540 Mil.Quanto as caracteristicas das casas, o nº de banheiros maximo registrado com 33, chama a atenção visto que as demais medidas separatrizes sugerem que a casa com maior numero de quartos não supere muito em 4 quartos.
#Gráficos conjugados histograma e boxplot
layout(mat = matrix(c(1:12),4,3, byrow=TRUE), height = c(rep(c(0.2,0.7),2)))
# construção do grid de impressão 3 linhas x 4 colunas
for (i in seq(1,4,by=3)){ #linhas de impressão para cada par de gráficos
par(mar=c(0,4, 0, 1)) #limites das margensdos box-plots
for (i2 in i:(i+2)){ #gerando os box-plots
boxplot(house.1[,i2],xlab=nomes[i2],col="light blue",outcol="red",
horizontal=TRUE, xaxt="n", frame=F)
}
par(mar=c(5,4,0,1)) #limites das margens dos histogramas
for(i3 in i:(i+2)){ #gerando os histogramas
hist(house.1[,i3],xlab=nomes[i3],ylab="Densidade",
main="",col="light blue",prob=TRUE)
curve(dnorm(x,mean(house.1[,i3], na.rm=T),sd(house.1[,i3], na.rm=T)),add=T, col="red")
}
}
o painel da combinação do histograma e box-plot, apresenta um panorama geral das variáveis selecionadas. De maneira geral, a presença de consideráveis de valores discrepantes ganha destaque. Porém, tal resumo gráfico não se mostra tão adequado para variáveis qualitativas (categóricas) como a Visão da Propriedade. É conveniente uma avaliação especifica para variáveis quantitativas e qualitativas.
# Boxplots
layout(mat = matrix(c(1:4),2,2, byrow=TRUE), height = c(rep(c(0.2,0.7),2)))
par(mfrow=c(2,4),mar=c(4,4,3,2))
for(i in 1:(length(house.1)-2)){
out<-boxplot.stats(house.1[,i])$out #+/- 1.58 IQR/sqrt(n)
out_ind <- which(house.1[,i] %in% c(out))
boxplot(house.1[,i],ylab=nomes[i],col="light blue",frame=F, outcol="red")
mtext("Outlires (+)", side=1,line=0.5, at=0.7, cex = 0.6)
boxplot(house.1[-out_ind,i],ylab=nomes[i],col="light blue", frame=F)
mtext("Outlires ( - ) *", side=1,line=0.5, at=0.7, cex = 0.6)
}
par(oma=c(1,1,1.1,1),new=T,font=2,cex=0.5)
mtext(outer=TRUE,paste("Boxplots das variáveis avaliadas"),side=3)
mtext(outer=TRUE,paste("* Principais outliers removidos pelo método de Interválos interquartílico [+/-1.58 IQR/sqrt(n)]"),side=1, cex=0.8)
Os box-plots mostram a presença de muitas informações discrepantes, sugerindo uma avaliação mais aprofundada sobre a natureza destas com a possibilidade de remoção ou tratamento. No entanto, para este estudo, serão mantidos todos os dados originais.
#Ajuste da variável visão da propriedade
house.1<-cbind(house.1,view.f=house.1$view)
house.1$view.f<-factor(house.1$view.f, levels = c("0","1","2","3","4"))
#Ajuste da variável Nível de Construção e Design
house.1<-cbind(house.1,grade.f=house.1$grade)
house.1$grade.f[(house.1$grade %in% c(1:3))]<-"Low"
house.1$grade.f[(house.1$grade %in% c(4:6))]<-"Low-Med"
house.1$grade.f[(house.1$grade==7)]<-"Med"
house.1$grade.f[(house.1$grade %in% c(8:10))]<-"Med-High"
house.1$grade.f[(house.1$grade %in% c(11:13))]<-"High"
house.1$grade.f<-factor(house.1$grade.f, levels = c("Low","Low-Med","Med","Med-High", "High"))
#graficos das variaveis categóricas
par(mfrow = c(1,2))
x<-xtabs(~view.f,data = house.1)
barplot(x,
ylab = "Frequência absoluta",
xlab = nomes[5],
ylim = c(0,max(x)*1.1),#lim sup 10% a+ p/ max para melhor visualização
col=hcl.colors(length(x), "Green-Orange"))
x<-xtabs(~grade.f,data = house.1)
barplot(x,
ylab = "Frequência absoluta",
xlab = nomes[6],
ylim = c(0,max(x)*1.1),
col=hcl.colors(length(x), "Red-Green"),
cex.names = 0.6,
las=3)
par(oma=c(1,1,1.1,1),new=T,font=2,cex=0.5)
mtext(outer=TRUE,paste("Gráficos de Barras das Variáveis Categóricas"),side=3)
#gray.colors(n)
#hcl.pals() nomes das pallets
As variáveis categóricas mostram que a grande maioria da propriedade tem baixo nível na qualidade da visão, ao passo que o nível das construções são predominantemente consideradas como nível médio ou médio-alto.
#limpando a mémoria
rm(Resultados, EstDescri,out, out_ind,x,house.1,i,i2,i3)
Para as variáveis quantitativas, calcule a matriz de correlação e faça um gráco em que se possa facilmente visualizar as correlações entre as variáveis. Em seguida, faça diagramas de dispersão para os dois pares de variáveis mais correlacionados.
COR<-cor(vendas[,-c(1,2,12)])
# Kable é um gerador de tabela com formatação amigavel para saidas html
knitr::kable(COR,digits = 2,format.args = list(scientific = FALSE),
caption = "Correlação entre as variáveis do banco de dados")
| price | bedrooms | bathrooms | sqft_living | sqft_lot | floors | waterfront | view | condition | grade | sqft_above | sqft_basement | yr_built | yr_renovated | zipcode | lat | long | sqft_living15 | sqft_lot15 | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| price | 1.00 | 0.31 | 0.53 | 0.70 | 0.09 | 0.26 | 0.27 | 0.40 | 0.04 | 0.67 | 0.61 | 0.32 | 0.05 | 0.13 | -0.05 | 0.31 | 0.02 | 0.59 | 0.08 |
| bedrooms | 0.31 | 1.00 | 0.52 | 0.58 | 0.03 | 0.18 | -0.01 | 0.08 | 0.03 | 0.36 | 0.48 | 0.30 | 0.15 | 0.02 | -0.15 | -0.01 | 0.13 | 0.39 | 0.03 |
| bathrooms | 0.53 | 0.52 | 1.00 | 0.75 | 0.09 | 0.50 | 0.06 | 0.19 | -0.12 | 0.66 | 0.69 | 0.28 | 0.51 | 0.05 | -0.20 | 0.02 | 0.22 | 0.57 | 0.09 |
| sqft_living | 0.70 | 0.58 | 0.75 | 1.00 | 0.17 | 0.35 | 0.10 | 0.28 | -0.06 | 0.76 | 0.88 | 0.44 | 0.32 | 0.06 | -0.20 | 0.05 | 0.24 | 0.76 | 0.18 |
| sqft_lot | 0.09 | 0.03 | 0.09 | 0.17 | 1.00 | -0.01 | 0.02 | 0.07 | -0.01 | 0.11 | 0.18 | 0.02 | 0.05 | 0.01 | -0.13 | -0.09 | 0.23 | 0.14 | 0.72 |
| floors | 0.26 | 0.18 | 0.50 | 0.35 | -0.01 | 1.00 | 0.02 | 0.03 | -0.26 | 0.46 | 0.52 | -0.25 | 0.49 | 0.01 | -0.06 | 0.05 | 0.13 | 0.28 | -0.01 |
| waterfront | 0.27 | -0.01 | 0.06 | 0.10 | 0.02 | 0.02 | 1.00 | 0.40 | 0.02 | 0.08 | 0.07 | 0.08 | -0.03 | 0.09 | 0.03 | -0.01 | -0.04 | 0.09 | 0.03 |
| view | 0.40 | 0.08 | 0.19 | 0.28 | 0.07 | 0.03 | 0.40 | 1.00 | 0.05 | 0.25 | 0.17 | 0.28 | -0.05 | 0.10 | 0.08 | 0.01 | -0.08 | 0.28 | 0.07 |
| condition | 0.04 | 0.03 | -0.12 | -0.06 | -0.01 | -0.26 | 0.02 | 0.05 | 1.00 | -0.14 | -0.16 | 0.17 | -0.36 | -0.06 | 0.00 | -0.01 | -0.11 | -0.09 | 0.00 |
| grade | 0.67 | 0.36 | 0.66 | 0.76 | 0.11 | 0.46 | 0.08 | 0.25 | -0.14 | 1.00 | 0.76 | 0.17 | 0.45 | 0.01 | -0.18 | 0.11 | 0.20 | 0.71 | 0.12 |
| sqft_above | 0.61 | 0.48 | 0.69 | 0.88 | 0.18 | 0.52 | 0.07 | 0.17 | -0.16 | 0.76 | 1.00 | -0.05 | 0.42 | 0.02 | -0.26 | 0.00 | 0.34 | 0.73 | 0.19 |
| sqft_basement | 0.32 | 0.30 | 0.28 | 0.44 | 0.02 | -0.25 | 0.08 | 0.28 | 0.17 | 0.17 | -0.05 | 1.00 | -0.13 | 0.07 | 0.07 | 0.11 | -0.14 | 0.20 | 0.02 |
| yr_built | 0.05 | 0.15 | 0.51 | 0.32 | 0.05 | 0.49 | -0.03 | -0.05 | -0.36 | 0.45 | 0.42 | -0.13 | 1.00 | -0.22 | -0.35 | -0.15 | 0.41 | 0.33 | 0.07 |
| yr_renovated | 0.13 | 0.02 | 0.05 | 0.06 | 0.01 | 0.01 | 0.09 | 0.10 | -0.06 | 0.01 | 0.02 | 0.07 | -0.22 | 1.00 | 0.06 | 0.03 | -0.07 | 0.00 | 0.01 |
| zipcode | -0.05 | -0.15 | -0.20 | -0.20 | -0.13 | -0.06 | 0.03 | 0.08 | 0.00 | -0.18 | -0.26 | 0.07 | -0.35 | 0.06 | 1.00 | 0.27 | -0.56 | -0.28 | -0.15 |
| lat | 0.31 | -0.01 | 0.02 | 0.05 | -0.09 | 0.05 | -0.01 | 0.01 | -0.01 | 0.11 | 0.00 | 0.11 | -0.15 | 0.03 | 0.27 | 1.00 | -0.14 | 0.05 | -0.09 |
| long | 0.02 | 0.13 | 0.22 | 0.24 | 0.23 | 0.13 | -0.04 | -0.08 | -0.11 | 0.20 | 0.34 | -0.14 | 0.41 | -0.07 | -0.56 | -0.14 | 1.00 | 0.33 | 0.25 |
| sqft_living15 | 0.59 | 0.39 | 0.57 | 0.76 | 0.14 | 0.28 | 0.09 | 0.28 | -0.09 | 0.71 | 0.73 | 0.20 | 0.33 | 0.00 | -0.28 | 0.05 | 0.33 | 1.00 | 0.18 |
| sqft_lot15 | 0.08 | 0.03 | 0.09 | 0.18 | 0.72 | -0.01 | 0.03 | 0.07 | 0.00 | 0.12 | 0.19 | 0.02 | 0.07 | 0.01 | -0.15 | -0.09 | 0.25 | 0.18 | 1.00 |
A matriz e correlação é uma ótima manaira de analizar os níveis associação linear entre pares de variáveis. Póem matizes com grandes números de váriáveis, podem não ser tão claras.
#instalação de pacote necessário para ilustração da matriz de correlação
if (!require("corrplot")) install.packages("corrplot", dependencies = TRUE, INSTALL_opts = '--no-lock')
## Loading required package: corrplot
## corrplot 0.84 loaded
library(corrplot)
#ilustração da matrix de correlações de maneira mais amigável
corrplot(COR, method = "square", type="upper")
rm(COR)
O correlograma produzido pelo “corrplor”, evidencia associações consideráveis entre: price e bathrooms, sqft_living, grade, sqft_above e sqft_lot15; sqft_living e grade, sqft_above e sqft_lot15. As variáveis que representam áreas tem altos niveis de associação, pois algumas delas são composição de outras. Desta forma, estas variáveis podem ser consideradas autocorrelacionadas.
# par de maior correlação
plot(sqft_living ~ sqft_above,
data = vendas,
main = "Dispressão \n Interior da casa X Interior da casa acima do nível do solo ",
cex.main = 0.9,
xlab = "Interior da casa acima do nível do solo (ft²)",
ylab = "Interior da casa (ft²)",
xlim = c(0,14000),
pch = 21,
cex = 0.8,
col = "black",
bg = "gray",
frame= FALSE)
grid()
abline(coef = c(0,1), col="red")
O gráfico acima mostra a disperssão dos dados entra as duas variavais de maior correlação: a área do Interior da casa acima do nível do solo (ft²) e Interior da casa (ft²). A diagonal traçada em vermelho, mostra que a relação interior/acima será pelo menos 1. - As construções plotadas sobre a diagonal mostra que toda a construção está acima do solo e não temdo nada construído abaixo do solo; - Quanto mais afastado o ponto acima da diagonal se afasta dela maior a área contruída no subsolo; - Nenhuma construção é totalmente no subsolo.
Verifique grafiamente a associação entre o preço e pelo menos três outras variáveis do banco de dados. Investigue a melhor forma de visualização: gráco de dispersão, box-blots.
#Disperssão 01
cols<-hcl.colors(length(levels(as.factor(vendas$waterfront))), "Green-Orange")
plot(price/1000 ~ sqft_living,
data = vendas,
main = "Preço X Interior da Casa \n (by Beira-mar)",
xlab = "Interior da casa (ft²)",
ylab = "Preço (US$ *1.000)",
cex.main = 0.9,
bg = cols,
pch = 21,
cex=0.8,
frame= F)
legend("top",
pch = 21,
lty = 0,
col = "black",
pt.bg = cols,
legend = c("Outros locais","Baira-mar"),
bty = "n")
grid()
rm(cols)
É possível observar uma relação positiva entre o preço de venda e o interior da casa. No entanto, não é possível visualizar alguma relação entre elas e a posição da construção a beira-mar.
#Disperssão 01
cols<-hcl.colors(length(levels(factor(vendas$condition))), "inferno")
plot(price/1000 ~ bedrooms,
data = vendas,
main = "Preço X Nº de Quartos \n (by Condição do Apartamento)",
xlab = "Nº de Quartos",
ylab = "Preço (US$ *1.000)",
cex.main = 0.9,
bg = cols,
pch = 21,
cex=0.8,
frame= F)
legend("top",
pch = 21,
lty = 0,
col = "black",
pt.bg = cols,
legend = levels(factor(vendas$condition)),
bty = "n")
grid()
rm(cols)
A disperssão de preço de venda x nº de quartos associada a condição da Cosntrução não mostra nhenuma relação entre elas .
x<- data.frame(Indice=c(4,5,10,13,9),Nomes=(c(nomes[c(2,3,5,6)],"Beira-Mar")))
par(mfrow = c(2,3))
for(i in 1:length(x$Indice)){
boxplot((vendas$price/1000) ~ vendas[,x$Indice[i]],
xlab = x$Nomes[i],
ylab = "Preço de Venda (US$ x1.000)",
col = "light blue",
frame = FALSE,
outcol= "red")
}
rm(x)
As distribuições dos preços por grupos das variáveis nas representações dos box-plot, sedo possível notar oma relação positiva entre o preço e as medianas dos grupos da variáveis.
Agrupe os dados por data (mês e ano) e calcule a média do preço para cada mês. Em seguida, faça um gráfico de linha com a variação do preço ao longo do tempo.
A partir dos preços e pés quadrados do interior da casa, calcule, para cada registro, o preço médio do pé quadrado. Em seguida, faça um gráco de linha com a variação do preço médio ao longo do tempo.
# instalação de pacotes para criação de gráfico temporal
.packages = c("dygraphs", "xts")# Lista de bibliotecas necessárias
# Instalar (caso ainda não tenha sido instalado)
.inst <- .packages %in% installed.packages()
if(length(.packages[!.inst]) > 0) install.packages(.packages[!.inst],dependencies = TRUE)
# Carregando bibliotecas
lapply(.packages, require, character.only=TRUE)
#Arupando a média do preço de venda por date2()
x <- aggregate(vendas$price/1000, by = list(vendas$date2), FUN=mean)
#criando a sequencia de datas para auxiliar no gráfico.
x <-cbind(x,time=seq(from= as.Date("01/05/2014","%d/%m/%Y"),
to = as.Date("01/05/2015","%d/%m/%Y"),
by = "month"))
# Necessário trnasformar em formato "xts" para poder usar o dygraph
graf <- xts(x = x$x, order.by = x$time)
dygraph(graf,
main="Comportamento da Média de Preços de Venda",
ylab="Preços de Venda (US$ *1.000)",
xlab="Meses")
rm(x,graf)
A média de preços dos imóveis teve um comportamente de queda até fev/2015, quando retomou uma subida muito rápida.
# criando variável preço por ft² constrída
vendas <- cbind(vendas, price_ft2 = (vendas$price/vendas$sqft_living))
#Arupando a média do preço/ft² date2()
x <- aggregate(vendas$price_ft2, by = list(vendas$date2), FUN=mean)
#criando a sequencia de datas para auxiliar no gráfico.
x <-cbind(x,time=seq(from= as.Date("01/05/2014","%d/%m/%Y"),
to = as.Date("01/05/2015","%d/%m/%Y"),
by = "month"))
# Necessário trnasformar em formato "xts" para poder usar o dygraph
graf <- xts(x = x$x, order.by = x$time)
dygraph(graf,
main="Comportamento da Média de Preços/ft² do Interior da Casa",
ylab="Preços de Venda/ft²",
xlab="Meses")
rm(x,graf)
o preço médio por ft² tem um movimento suave de queda no periodo de Mai/2014 a Dez/2014, onde foi registrado o menor patamar do preço. A partir de então um comportamento de valorização rápida superando os patamares anterioes no 3º mes subida.
Calcule os quartis do preço (valores que dividem os preços em quatro faixas, cada um com 25% dos registros). Verifique em que faixa cada preço do banco de dados se encontra e associe a ele um cor diferente. Em seguida, faça um gráco em três dimensões com a latitude, longitude e o preço (com as cores correspondentes à sua respectiva faixa).
## Loading required package: scatterplot3d
# classificação dos quartis de preços de venda
vendas<-cbind(vendas,
price.q = with(vendas,
cut(price,
breaks = quantile(price,
probs=seq(0,1, by=0.25),
na.rm=TRUE),
labels = 1:4,
include.lowest=TRUE)))
#Scaterplot 3D
#Paleta de cores
cols<-hcl.colors(length(levels(vendas$price.q)), "PuOr")
with(vendas,{
scatterplot3d(lat,long,price/1000,
main = "3-D Scaterplot",
xlab="Latitude",
zlab="Preço de Venda (US$ x1.000)",
ylab="Longitude",
type="p",
lty.hplot=2,
scale.y=.5,
box=T,
color=cols[price.q],
pch=16,
angle=45)
})
A dispersão em 3 dimensões apresenta uma visualização planos na malha de latitude e logitude para cada nível dos quartis dos preços de vendas. Estes planos poderiam ser mais bem identificados com o isolamento dos maiores preços, os quais distorcem o eixo causando uma sobreposição visual dos pontos.
## Loading required package: rgl
## Warning: package 'rgl' was built under R version 4.0.4
# Retirada de uma amostra aleatória de 1000 casas para ilustrar o grafico interativo
vendas.1<-vendas[sample(1:nrow(vendas),1000,replace=F),]
cols<-hcl.colors(length(levels(vendas$price.q)), "PuOr")
# Grafico interativo simples
plotids <- with(vendas.1, plot3d(lat,long,(price/1000),
type="s", col=cols[price.q],size=1))
rglwidget(elementId = "plot3drgl")
#grafico interativo mais elaborado com a possibilidade de exibição dos elementos
clear3d() # Remove the earlier display
#rm(axesid)
# Ciração dos elementos para o objeto grafico3d de acordo com os elementos da biblioteca rgl
Q1 <- with(subset(vendas.1, price.q == 1),
spheres3d(lat,long,(price/1000),
col=cols[price.q],
radius = 50))
Q2 <- with(subset(vendas.1, price.q == 2),
spheres3d(lat,long,(price/1000),
col=cols[price.q],
radius = 50))
Q3 <- with(subset(vendas.1, price.q == 3),
spheres3d(lat,long,(price/1000),
col=cols[price.q],
radius = 50))
Q4 <- with(subset(vendas.1, price.q == 4),
spheres3d(lat,long,(price/1000),
col=cols[price.q],
radius = 50))
#criando o objeto grafico3d, criado por plot3d ou decorate3d
axesid <- decorate3d(xlab = "Latitude", ylab = "Logitude", zlab = "Preço (x1.000)")
#incluindo os elementos no objeto grafico3d
rglwidget() %>%
toggleWidget(ids = Q1) %>%
toggleWidget(ids = Q2) %>%
toggleWidget(ids = Q3) %>%
toggleWidget(ids = Q4) %>%
toggleWidget(ids = axesid) %>%
asRow(last = 5)
#número e objetos a serem apresentados recomendo que seja last=nº de elementos toggleWinget
#assim será apresentado em uma linha abaixo do gráfico
library(leaflet)
##
## Attaching package: 'leaflet'
## The following object is masked from 'package:xts':
##
## addLegend
cols<-c("orange", "lightgreen", "lightblue", "purple")
vendas.1<-cbind(vendas.1,House=paste("House ",c(1:dim(vendas.1)[1])))
printMoney <- function(x){
format(x, digits=10, nsmall=2, decimal.mark=",", big.mark=".")
}
icone <- awesomeIcons(
icon = 'home',
iconColor = "white",
library = 'ion',
markerColor = cols[vendas.1$price.q]
)
leaflet(vendas.1) %>%
addTiles() %>%
addAwesomeMarkers(popup = with(vendas.1,
paste("<b>Preço: US$</b>",printMoney(price),"<br>",
"<b>Banheiros: </b>",bathrooms,"<br>",
"<b>Quartos: </b>",bedrooms)),
icon=icone,
label= ~House)
## Assuming "long" and "lat" are longitude and latitude, respectively
vendas.2<-cbind(vendas.1,
price.qq = with(vendas.1,
cut(price/1000,
breaks = quantile(price/1000,
probs=seq(0,1, by=0.25),
na.rm=TRUE),
#labels = 1:4,
include.lowest=TRUE)))
vendas.df <- split(vendas.2, vendas.2$price.qq)
l <- leaflet() %>% addTiles()
names(vendas.df) %>%
purrr::walk( function(df) {
l <<- l %>%
addMarkers(data=vendas.df[[df]],
lng=~long, lat=~lat,
label=~price.q,
popup = with(vendas.df[[df]],
paste("<b>Preço: US$</b>",printMoney(~price),"<br>",
"<b>Banheiros: </b>",~bathrooms,"<br>",
"<b>Quartos: </b>",~bedrooms)),
group = df,
clusterOptions = markerClusterOptions(removeOutsideVisibleBounds = F),
labelOptions = labelOptions(noHide = F,
direction = 'auto'))
})
l %>%
addLayersControl(
overlayGroups = names(vendas.df),
options = layersControlOptions(collapsed = FALSE)
)
A atividade deve ser feita no R Markdown e entregue em HTML ou PDF com os códigos explicitados e as análises comentadas. Os grácos devem ser explicativos, com nomes corretos nos eixos, por exemplo↩︎